;;; Copyright © 2020 Maxime Devos <maxime.devos@student.kuleuven.be>
;;; This file is part of rehash.
;;;
;;; rehash is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; rehash is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with rehash.  If not, see <http://www.gnu.org/licenses/>.

;;; Summary: test store-mapping! in isolation
;;;
;;; Completion test A:
;;;  * a store can be requested before the rehash service is up
;;;  * in which case the store cannot be completed before the service is up
;;;  * when the rehash service is up, the store will complete
;;;  * in which case the store isn't marked aborted, but is marked
;;;    as completed
;;;  * the store can still be aborted, in which case wait-for-store-done
;;;    still returns #t and the store is both aborted and completed
;;;
;;; Completion test B:
;;;  * a store can be requested after the rehash service is up
;;;  * the store will complete
;;;
;;; Abortion test A:
;;;  * a store can be aborted before the rehash service is up
;;;  * when done so, the ‘aborted’ condition is signalled
;;;  * and wait-for-store-done returns #f
;;;  * the store can then be aborted again (to no effect),
;;;    in which case the ‘aborted’ condition stays signalled
;;;  * and wait-for-store-done still returns #f
;;;
;;; Abortion test B:
;;;  * a store can be aborted after the rehash service is up
;;;  * when done so, the ‘aborted’ condition is signalled
;;;  * due to concurrency issues, it might be possible
;;;    that the request has completed
;;;    (TODO: artificially suspend the DHT and/or datastore
;;;    to test for not-completedness)
;;;  * the store can then be aborted again (to no effect),
;;;    in which case the ‘aborted’ condition stays signalled
;;;  * and wait-for-store-done returns the same result
;;;    as in step 3

;; TODO implement other tests

(use-modules (test-utils)
	     (fibers)
	     (fibers operations)
	     (fibers timers)
	     ((fibers internal)
	      #:select (yield-current-fiber))
	     (rehash)
	     (rehash operations)
	     (rehash fibers)
	     (srfi srfi-64))

;; Some different hashes.
;; The exact hashes used don't
;; matter for this test.
(define h0 #f)
(define h1 #f)
(define h2 #f)
(define h3 #f)

(define key-arguments
  ;; FIXME this will expire 584 millenia past the Unix epoch
  `(#:expiration-time ,almost-infinity
    #:anonymity-level 0))

(define (init-hashes!)
  ;; TODO these are actually bad,
  ;; and will be rejected in the future
  (set! h0 (bytevector->hash HASH_SHA256   #vu8(3 0) 0 2))
  (set! h1 (bytevector->hash HASH_SHA512   #vu8(2 1) 0 2))
  (set! h2 (bytevector->hash HASH_SHA3_256 #vu8(1 2) 0 2))
  (set! h3 (bytevector->hash HASH_SHA3_512 #vu8(0 3) 0 2)))

(define (yield-repeat N)
  (for-each (lambda (_) (yield-current-fiber))
    (iota N)))
(define N 16)

(define (store-aborted? store)
  (perform-operation
   (choice-operation
    (wrap-operation (wait-for-store-aborted-operation store)
		    (lambda () #t))
    (wrap-operation (sleep-operation 0)
		    (lambda () #f)))))

(define (store-completed? store)
  (display store)
  (perform-operation
   (choice-operation
    (wrap-operation (wait-for-store-done-operation store)
		    (lambda () #t))
    (wrap-operation (sleep-operation 0)
		    (lambda () #f)))))

(define (completion-test-A)
  (let ((rehash #f)
	(store #f)
	(setup (make-gnunet-setup "Completion test A")))
    (test-group-with-cleanup/fibers "Completion test A"
      ;; FIXME (see AAA) stores aren't succeeding if
      ;; the connection is made before gnunet is
      ;; started.
      (test-assert "startup order bug has been fixed" #f)
      (gnunet-setup-start! setup)
      (sleep 1)
      (set! rehash (connect-rehash/test setup))
      (set! store (apply store-mapping! rehash h0 h1
			 key-arguments))
      (yield-repeat N)
      (test-eq "no completion before the store is up (A)"
	#f (store-completed? store))
      ;; See AAA
      #;(gnunet-setup-start! setup)
      (test-eq "completion after the store is up (A, 0)"
	#t (wait-for-store-done store))
      (test-eq "completion after the store is up (A, 1)"
	#t (store-completed? store))
      (test-eq "completion does not imply abortion (A)"
	#f (store-aborted? store))
      (abort-store! store)
      (yield-repeat N)
      (test-eq "completed stores remain completed (A, 0)"
	#t (wait-for-store-done store))
      (yield-repeat N) ;; TODO figure out why this is necessary
      (test-eq "completed stores remain completed (A, 1)"
	(store-completed? store) #t)
      (begin (when rehash (disconnect-rehash rehash))
	     (gnunet-setup-exit! setup)))))

(define (completion-test-B)
  (let ((rehash #f)
	(store #f)
	(setup (make-gnunet-setup "Completion test B")))
    (test-group-with-cleanup/fibers "Completion test B"
      (gnunet-setup-start! setup)
      ;; FIXME: remove the sleeping
      (test-assert "no timing issues (B)" #f)
      (sleep 1)
      (set! rehash (connect-rehash/test setup))
      (set! store (apply store-mapping! rehash h0 h1
			 key-arguments))
      (test-eq "completion after the store is up (B, 0)"
	#t (wait-for-store-done store))
      (test-eq "completion after the store is up (B, 1)"
	#t (store-completed? store))
      (begin (when rehash (disconnect-rehash rehash))
	     (gnunet-setup-exit! setup)))))

(define (main/time-ok)
  (run-fibers (lambda ()
		(init-hashes!)
                (init-fibers-scheduler!)
                (start-fibers-scheduler!)
		(test-expect-fail "startup order bug has been fixed")
		(test-expect-fail "no timing issues (B)")
		;; flaky, perhaps some concurrency bug,
		;; perhaps some misunderstanding of guile-fibers
		(test-expect-fail "completion after the store is up (A, 1)")
		(test-expect-fail "completed stores remain completed (A, 1)")
		(test-expect-fail "completion after the store is up (B, 1)")
		(completion-test-A)
		(completion-test-B))))

(define (main/time-not-ok)
  (for-each (lambda (s)
	      (test-skip s)
	      (test-assert s #f))
    '("Completion test A"
      "Completion test B"
      "Abortion test A"
      "Abortion test B")))

(if (check-time-format)
    (main/time-ok)
    (main/time-not-ok))

;;; Local Variables:
;;; eval: (put 'test-group-with-cleanup/fibers 'scheme-indent-function 1)
;;; End:
